home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE05 / INTERNAL / CPUKIND.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1995-11-08  |  6.1 KB  |  176 lines
  1. unit CPUKind;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs;
  8.  
  9. type
  10.     TCPUName = class(TComponent)
  11.     private
  12.         { Private declarations }
  13.         function GetCPUKind: Integer;
  14.         function GetCPUName: String;
  15.         procedure NOPInteger (val: Integer);
  16.         procedure NOPString (val: String);
  17.     protected
  18.         { Protected declarations }
  19.     public
  20.         { Public declarations }
  21.     published
  22.         { Published declarations }
  23.         property CPUKind: Integer read GetCPUKind write NOPInteger; { read-only! }
  24.         property CPUName: String read GetCPUName write NOPString;   { read-only! }
  25.   end;
  26.  
  27. procedure Register;
  28.  
  29. implementation
  30.  
  31. const
  32.     i8086       = 1;           { includes 8088 CPU as well }
  33.     i80286      = 2;
  34.     i80386      = 3;
  35.     i80486      = 4;
  36.     iPentium    = 5;           { P5 - Pentium }    
  37.     iPentiumPro = 6;           { P6 - Pentium Pro }
  38.  
  39. var
  40.     id: Integer;
  41.  
  42. { Assembly function to get CPU type including Pentium and later }
  43.  
  44. function CpuID: Integer; assembler;
  45. asm
  46.     push        ds               { first, check for 8086 - Flag bits 12-15 always set }
  47.     call        GetWinFlags      { call Windows API }
  48.     or          ax,wf_CPU286     { or with 80286 processor bit }
  49.     mov         ax,i80286        { assume 286 }
  50.     jz          @@1              { branch if it was }
  51.  
  52.     { Not a 80286 - let's check for a 8088/8086 next }
  53.  
  54.     pushf                        { save EFLAGS }
  55.     pop        bx               { store EFLAGS in BX }
  56.     mov        ax,0fffh         { clear bits 12-15 }
  57.     and        ax,bx            { in EFLAGS }
  58.     push    ax               { store new EFLAGS value on stack }
  59.     popf                         { replace current EFLAGS value }
  60.     pushf                        { set new EFLAGS }
  61.     pop        ax               { store new EFLAGS in AX }
  62.     and        ax,0f000h        { if bits 12-15 are set, then 8086 }
  63.     cmp        ax,0f000h        { is an 8086/8088 ? }
  64.     mov     ax,i8086         { turn on 8086/8088 flag }
  65.     je        @@1              { yes - all done }
  66.  
  67.   { To test for 386 or better, we need to use 32 bit instructions,
  68.     but the 16-bit Delphi assembler does not recognize the 32 bit opcodes
  69.     or operands.  Instead, use the 66H operand size prefix to change
  70.     each instruction to its 32-bit equivalent. For 32-bit immediate
  71.     operands, we also need to store the high word of the operand immediately
  72.     following the instruction.  The 32-bit instruction is shown in a comment
  73.     after the 66H instruction.
  74.   }
  75.  
  76.     db        66h               { pushfd }
  77.     pushf
  78.     db        66h               { pop eax }
  79.     pop          ax                { get original EFLAGS }
  80.     db        66h               { mov ecx, eax }
  81.     mov          cx,ax        { save original EFLAGS }
  82.     db        66h               { xor eax,40000h }
  83.     xor          ax,0h            { flip AC bit in EFLAGS }
  84.     dw        0004h
  85.     db        66h               { push eax }
  86.     push      ax        { save for EFLAGS }
  87.     db        66h               { popfd }
  88.     popf            { copy to EFLAGS }
  89.     db        66h               { pushfd }
  90.     pushf            { push EFLAGS }
  91.     db        66h               { pop eax }
  92.     pop          ax        { get new EFLAGS value }
  93.     db        66h               { xor eax,ecx }
  94.     xor          ax,cx        { can't toggle AC bit, CPU=Intel386 }
  95.     mov       ax,i80386         { turn on 386 flag }
  96.     je        @@1
  97.  
  98.   { i486 DX CPU / i487 SX MCP and i486 SX CPU checking }
  99.   { Checking for ability to set/clear ID flag (Bit 21) in EFLAGS }
  100.   { which indicates the presence of a processor }
  101.   { with the ability to use the CPUID instruction. }
  102.  
  103.     db       66h                { pushfd }
  104.     pushf            { push original EFLAGS }
  105.     db       66h                { pop eax }
  106.     pop         ax                { get original EFLAGS in eax }
  107.     db       66h                { mov ecx, eax }
  108.     mov         cx,ax        { save original EFLAGS in ecx }
  109.     db       66h                { xor eax,200000h }
  110.     xor         ax,0h            { flip ID bit in EFLAGS }
  111.     dw       0020h
  112.     db       66h                { push eax }
  113.     push     ax                { save for EFLAGS }
  114.     db       66h                { popfd }
  115.     popf            { copy to EFLAGS }
  116.     db       66h                { pushfd }
  117.     pushf                       { push EFLAGS }
  118.     db       66h                { pop eax }
  119.     pop         ax                { get new EFLAGS value }
  120.     db       66h                { xor eax, ecx }
  121.     xor      ax, cx
  122.     mov      ax,i80486          { turn on i486 flag }
  123.     je       @@1            { if ID bit cannot be changed, CPU=486 }
  124.                     { without CPUID instruction functionality }
  125.  
  126.   { Execute CPUID instruction to determine vendor, family, }
  127.   { model and stepping.  The use of the CPUID instruction used }
  128.   { in this program can be used for B0 and later steppings }
  129.   { of the P5 processor. }
  130.  
  131.     db       66h                { mov eax, 1 }
  132.     mov      ax, 1            { set up for CPUID instruction }
  133.     dw       0
  134.     db       66h                { cpuid }
  135.     db         0Fh            { Hardcoded opcode for CPUID instruction }
  136.     db         0a2h
  137.     db       66h                { and eax, 0F00H }
  138.     and      ax, 0F00H            { mask everything but family }
  139.     dw       0
  140.     db       66h                { shr eax, 8 }
  141.     shr      ax, 8              { shift the cpu type down to the low byte }
  142. @@1:
  143.     pop      ds
  144. end;
  145.  
  146. procedure TCPUName.NOPInteger(val: Integer); begin end;
  147. procedure TCPUName.NOPString(val: String); begin end;
  148.  
  149. function TCPUName.GetCPUKind: Integer;
  150. begin
  151.     Result := id;
  152. end;
  153.  
  154. function TCPUName.GetCPUName: String;
  155. begin
  156.     case id of
  157.         i8086:    Result := '8086';
  158.         i80286:   Result := '80286';
  159.         i80386:   Result := '80386';
  160.         i80486:   Result := '80486';
  161.         iPentium: Result := 'Pentium';
  162.         iPentiumPro:    Result := 'Pentium Pro';
  163.         else      Result := Format ('P%d', [id]);
  164.     end;
  165. end;
  166.  
  167. procedure Register;
  168. begin
  169.     RegisterComponents ('Pilgrim''s Progress', [TCPUName]);
  170. end;
  171.  
  172. begin
  173.     id := CpuID;        { unit initialisation }
  174. end.
  175. 
  176.